home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / rkey14.zip / RKSAMPLE.PAS < prev   
Pascal/Delphi Source File  |  1991-02-07  |  3KB  |  152 lines
  1. Program RkSample;
  2.  
  3. {
  4.  This is a sample Program using rKey.
  5.  This is a very simple Program that doesn't actually do anything, but it
  6.  should demonstrate some of what can be done with rKey.
  7. }
  8.  
  9.  
  10. Uses
  11.   Crt, rKey;
  12.  
  13.  
  14. Const
  15.   RkSampleVer = '2.4';
  16.  
  17.  
  18. Var
  19.   kc : Char;
  20.  
  21.  
  22. Procedure BadRegBeep;
  23.  
  24. Begin
  25.   Sound(1200);
  26.   Delay(200);
  27.   Sound(600);
  28.   Delay(200);
  29.   Sound(1200);
  30.   Delay(200);
  31.   Sound(600);
  32.   Delay(200);
  33.   NoSound;
  34. End;
  35.  
  36.  
  37. Procedure NotRegBeep;
  38.  
  39. Begin
  40.   Sound(600);
  41.   Delay(200);
  42.   Sound(1200);
  43.   Delay(200);
  44.   NoSound;
  45. End;
  46.  
  47.  
  48. Procedure DoView;
  49.  
  50. Begin
  51.   WriteLn('Sample data :');
  52.   WriteLn;
  53.   WriteLn('4.465536  7.918270  0.118373  5.367233');
  54.   WriteLn('1.396349  4.868343  7.079323  4.783021');
  55.   WriteLn('3.947924  8.864673  8.846264  2.999999');
  56.   WriteLn('8.490832  6.874378  5.338329  3.729270');
  57.   WriteLn('6.839882  8.873478  6.750373  7.018948');
  58.   WriteLn('5.034784  3.003763  3.253290  4.892387');
  59.   WriteLn('3.874378  8.314159  9.880869  3.987842');
  60.   WriteLn('2.764947  9.265358  4.013002  9.903278');
  61. End;
  62.  
  63.  
  64. Procedure DoCalc;
  65.  
  66. Begin
  67.   If RegStatus then Begin
  68.     Write('The calculated result is ');
  69.     WriteLn(4.465536+7.918270+0.118373+5.367233+1.396349+4.868343+7.079323+4.783021
  70.     +3.947924+8.864673+8.846264+2.999999+8.490832+6.874378+5.338329+3.729270
  71.     +6.839882+8.873478+6.750373+7.018948+5.034784+3.003763+3.253290+4.892387
  72.     +3.874378+8.314159+9.880869+3.987842+2.764947+9.265358+4.013002+9.903278);
  73.   End Else
  74.     WriteLn('Not available in evaluation version!');
  75. End;
  76.  
  77.  
  78. Procedure DoTest;
  79.  
  80. Begin
  81.   If RegStatus then Begin
  82.     Write('Performing tests...');
  83.     Delay(300);
  84.     WriteLn;
  85.     WriteLn('All tests passed.');
  86.   End Else
  87.     WriteLn('Not available in evaluation version!');
  88. End;
  89.  
  90.  
  91. Begin
  92.   OwnerCode := 'ArgleBarbWotsLeeb';
  93.   ProgramCode := 'RkSample Two';
  94.   KeyFileName := 'RKSAMPLE';
  95.   GetRegInfo;
  96.   Write('RkSample v' + RkSampleVer);
  97.   If RegError then
  98.     WriteLn(' [invalid]')
  99.   Else If RegStatus then
  100.     WriteLn(' [registered]')
  101.   Else
  102.     WriteLn(' [evaluation]');
  103.   WriteLn('(c) 1990 TrEndSoft, Inc.');
  104.   WriteLn;
  105.   If RegError then Begin
  106.     WriteLn(KeyFilePath+' has been altered!');
  107.     WriteLn('Please contact TrEndSoft, Inc. to obtain a valid key file.');
  108.     BadRegBeep;
  109.     Halt(1);
  110.   End Else If RegStatus then Begin
  111.     WriteLn('This version of RkSample is registered to '+RegName);
  112.     WriteLn('Thank you for registering!');
  113.   End Else Begin
  114.     WriteLn('This version of RkSample is a limited evaluation copy.');
  115.     WriteLn('Contact TrEndSoft, Inc. for information on obtaining a registered version.');
  116.     NotRegBeep;
  117.     Delay(500);
  118.   End;
  119.   WriteLn;
  120.   Write('RkSample v' + RkSampleVer);
  121.   If Not RegStatus then
  122.     Write(' Evaluation');
  123.   WriteLn(' Menu');
  124.   WriteLn;
  125.   WriteLn('[V]iew sample data');
  126.   Write('[C]alculate');
  127.   If Not RegStatus then
  128.     WriteLn('  (not available in evaluation version)')
  129.   Else
  130.     WriteLn;
  131.   Write('[T]est results');
  132.   If Not RegStatus then
  133.     WriteLn('  (not available in evaluation version)')
  134.   Else
  135.     WriteLn;
  136.   WriteLn;
  137.   Write('Selection : ');
  138.   kc := UpCase(ReadKey);
  139.   WriteLn;
  140.   WriteLn;
  141.   Case kc of
  142.   'V' :
  143.     DoView;
  144.   'C' :
  145.     DoCalc;
  146.   'T' :
  147.     DoTest;
  148.   Else
  149.     WriteLn('Invalid selection!');
  150.   End;
  151. End.
  152.